home *** CD-ROM | disk | FTP | other *** search
- /* ftnchek.c:
-
- Main program for Fortran Syntax Checker.
-
- Copyright (C) 1993 by Robert K. Moniot.
- This program is free software. Permission is granted to
- modify it and/or redistribute it, retaining this notice.
- No guarantees accompany this software.
-
-
- Top-level input/output is done here: opening and closing files,
- and printing error, warning, and informational messages.
-
- Shared functions defined:
- print_a_line() Prints source code line.
- yyerror() Error messages from yyparse and elsewhere.
- syntax_error() Error messages with line and column num.
- warning() Warning messages.
- nonportable() Portability warnings.
- wrapup() Look at cross references, etc.
- */
-
- #include <stdio.h>
- #include <string.h>
- #include <ctype.h>
- #ifdef DEVELOPMENT /* For maintaining the program */
- #define DEBUG_SIZES
- #endif
- #define MAIN
- #include "ftnchek.h"
-
- #ifdef VMS
- #define unlink(s) remove(s)
- #endif
-
-
- void
- debug_symtabs();
-
- PRIVATE void
- error_message(), lintstyle_error_message(), oldstyle_error_message(),
- error_summary(), get_env_options(),
- make_env_name(), print_version_number(), set_option(),
- list_options(), open_outfile(),
- resource_summary(), src_file_in(), wrapup();
- #ifdef ALLOW_INCLUDE
- PRIVATE void append_include_path();
- #endif
-
- #ifdef DEBUG_SIZES
- extern void print_sizeofs(); /* in symtab.c */
- #endif
-
-
- #ifndef VMS_INCLUDE /* add_ext and has_extension shared with forlex.c
- include handler for vms specifics only */
- PRIVATE
- #endif
- char *add_ext();
-
- #ifndef VMS_INCLUDE
- PRIVATE
- #endif
- int has_extension();
-
- PRIVATE char *new_ext();
-
- PRIVATE int read_setting();
-
- PRIVATE int project_file_input; /* true if input is from .prj file */
-
- #define full_output (do_list || do_symtab)
-
- PRIVATE unsigned long intrins_clashes;
- /* count of intrinsic hashtable clashes */
- #ifdef COUNT_REHASHES
- extern unsigned long rehash_count; /* count of calls to rehash() */
- #endif
-
- /* Here we define the commandline options. Most options are boolean
- switchopts, with "no" prefix to unset them. Others (called
- settings) are numeric quantities, defined using "=num".
- A third category (strsettings) are string quantities, eg filenames.
- The argument "?" will cause list of options to be printed out.
- For VMS, options can be prefixed with either "-" or "/",
- but messages will use the canonical form. */
-
- #ifdef OPTION_PREFIX_SLASH
- #define OPT_PREFIX '/' /* Canonical VMS prefix for commandline options */
- #else
- #define OPT_PREFIX '-' /* Canonical Unix prefix for commandline options */
- #endif
-
- #define OPT_MATCH_LEN 3 /* Options are matched only in 1st 3 chars */
- #define NUM_SWITCHES (sizeof(switchopt)/sizeof(switchopt[0]))
- #define NUM_SETTINGS (sizeof(setting)/sizeof(setting[0]))
- #define NUM_STRSETTINGS (sizeof(strsetting)/sizeof(strsetting[0]))
-
- /* Option definitions:
- New options can be added to lists by inserting definition
- here using same syntax as others, and declaring the variable
- with OPT(type,name,default); in ftnchek.h. No other changes
- needed.
- */
-
-
- /* List of switches is defined first. Each entry gives the
- name and the corresponding flag variable to be set
- or cleared. See set_option() for processing of switches.
-
- N.B. list_options() will suppress printing of any options
- whose explanation starts with "debug" unless the -debug
- switch was previously given.
- */
- PRIVATE struct {
- char *name;
- int *switchflag;
- char *explanation;
- } switchopt[]={
- {"backslash", &unix_backslash,"unix-style backslash escape char"},
- {"calltree", &print_call_tree,"print subprogram call tree"},
- {"crossref", &print_xref_list,"print call cross-reference list"},
- {"declare", &decls_required,"list undeclared variables"},
- {"division", &div_check, "catch possible div by 0"},
- {"extern", &ext_def_check, "check if externals defined"},
- {"f77", &f77_standard, "warn of nonstandard constructs"},
- {"help", &help_screen, "print help screen"},
- {"hollerith", &hollerith_check,"warn about holleriths under -port"},
- {"library", &library_mode, "treat next files as library"},
- #ifdef EOLSKIP
- {"linebreak", &eol_is_space, "treat linebreaks as space"},
- #endif
- {"list", &do_list, "print program listing"},
- {"novice", &novice_help, "extra help for novices"},
- {"portability", &port_check, "check for portability problems"},
- {"pretty", &pretty_flag, "warn of deceiving appearances"},
- {"project", &make_project_file, "create project file"},
- {"pure", &pure_functions,"functions have no side effects"},
- {"reference", &print_ref_list,"print who-calls-who reference list"},
- {"resources", &show_resources,"show info on resource usage"},
- {"sixchar", &sixclash, "catch nonunique names"},
- {"sort", &print_topo_sort,"prerequisite-order sort of modules"},
- {"symtab", &do_symtab, "print symbol table info"},
- {"tab", &dec_tabs, "tab-formatted source file"},
- {"truncation", &trunc_check, "check for truncation pitfalls"},
- #ifdef VCG_SUPPORT
- {"vcg", &print_vcg_list,"print call graph in vcg format"},
- #endif
- {"verbose", &verbose, "verbose output"},
- {"volatile", &volatile_flag, "assume volatile common blocks"},
-
- {"debug", &debug_latest, "debug latest code"},
- {"global", &debug_glob_symtab, "debug global symtab info"},
- {"grammar", &debug_parser, "debug printout in parser"},
- {"hashtable", &debug_hashtab, "debug printout of hashtable"},
- {"local", &debug_loc_symtab, "debug local symtab info"},
- {"tokens", &debug_lexer, "debug printout in lexer"},
- {"yydebug", &yydebug, "debug via yydebug"},
- };
-
-
- /* List of settings is defined here. Each entry gives
- the name, the corresponding variable, the range
- of permitted values, the value for turning it off,
- followed by brief explanation.
- See set_option() for processing. */
- PRIVATE struct {
- char *name;
- int *setvalue;
- int minlimit,maxlimit,turnoff,min_default_value,max_default_value;
- char *explanation;
- } setting[]={
- {"arguments", &argcheck_strictness, 0, 3, 0, 0, 3,
- "check args: 0=none 1=number 2=type 3=all"},
- {"array", &array_arg_check, 0, 3, 0, 0, 3,
- "check array args: 0=none 1=dims 2=size 3=all"},
- {"columns", &max_stmt_col, 72, MAXLINE, 72, 72, MAXLINE,
- "max line length processed"},
- {"common", &comcheck_strictness, 0, 3, 0, 0, 3,
- "common check: 0=none 3=most strict"},
- {"makedcls", &make_dcls, 0, 511, 0, 1, 1,
- "make type declaration statements: sum of:\n\
- \t 1=declarations\n\
- \t 2=undeclared-only\n\
- \t 4=compact\n\
- \t 8=use-continuation-lines\n\
- \t 16=keywords-lowercase\n\
- \t 32=variables-and-constants-lowercase\n\
- \t 64=exclude-sftran3-internal-variables\n\
- \t128=asterisk-comment-character\n\
- \t256=lowercase-comment-char"},
- {"usage", &usage_check, 0, 3, 0, 0, 3,
- "0=no check, 1=used-not-set 2=unused 3=all"},
- {"wordsize", &given_wordsize, 0, 16, 0, 0, 16,
- "standard wordsize in bytes (0=no default)"},
- {"wrap", &wrap_column, 0, 999, 0, 0, 999,
- "width of page to wrap error messages"},
- };
-
-
- /* List of strsettings is defined here. Each entry gives
- the name the corresponding string variable, and brief
- explanation. See set_option() for processing. */
- PRIVATE struct {
- char *name;
- char **strvalue;
- char *explanation;
- } strsetting[]={
- #ifdef ALLOW_INCLUDE
- {"include", &include_path, "include-file directory"},
- #endif
- {"output", &out_fname, "output file name"},
- };
-
- PRIVATE int must_open_outfile=FALSE; /* Flag set to TRUE when out=name given */
-
- PRIVATE char *dclfile;
-
- int
- main(argc,argv)
- int argc;
- char *argv[];
- {
- int iarg;
- int filecount=0,actioncount=0;
- char *infile,*srcfile,*projfile;
-
- #ifdef VMS /* VMS version: expand wildcards, etc. */
- shell_mung(&argc,&argv,1,NULL);
- #endif
-
- list_fd = stdout;
- project_fd = (FILE *) NULL;
- error_count = 0;
- warning_count = 0;
-
- get_env_options();
- #ifdef ALLOW_INCLUDE
- include_path_list = (IncludePathNode*) NULL;
- if(include_path != (char *)NULL) {
- append_include_path(include_path);
- include_path = (char *)NULL; /* clear it for the next one */
- }
- #endif
- init_tables(); /* Initialize tables */
- init_keyhashtab();
- intrins_clashes = init_intrins_hashtab();
- init_globals();
- init_symtab();
-
- for(iarg=1; iarg < argc; iarg++) {
-
- int argchar=0;/* location of start of option */
- #ifdef OPTION_PREFIX_SLASH
- do { /* loop on flags within argv[iarg] */
- #endif
- if( argv[iarg][argchar] == '-'
- #ifdef OPTION_PREFIX_SLASH
- || argv[iarg][argchar] == '/' /* Allow VMS /option form */
- #endif
- ) {
- /* Process flags here */
-
- set_option(&argv[iarg][argchar]);
- if(help_screen) goto do_action;
- /* Handle -include=path option here */
- #ifdef ALLOW_INCLUDE
- if(include_path != (char *)NULL) {
- append_include_path(include_path);
- include_path = (char *)NULL;
- }
- #endif
-
- }
- else if(strcmp(&argv[iarg][argchar],"?") == 0) {
- help_screen = TRUE;
- goto do_action;
- }/*end of processing options*/
-
- else { /* Process file arguments */
- do_action:
-
- if( must_open_outfile )
- open_outfile(out_fname);
-
- if(actioncount == 0) {
- print_version_number();
- }
- ++actioncount; /* Cause exit w/o reading stdin below */
-
- /* Honor -help option */
- if(help_screen) {
- help_screen = FALSE;
- list_options(list_fd);
- }
- else { /* Process files here */
- ++filecount;
-
- srcfile = add_ext(&argv[iarg][argchar],DEF_SRC_EXTENSION);
- projfile = new_ext(&argv[iarg][argchar],DEF_PROJ_EXTENSION);
- dclfile = new_ext(&argv[iarg][argchar],DEF_DCL_EXTENSION);
-
- /* Project file mode: open source for reading
- and .prj file for writing. */
- if(make_project_file) {
-
- infile = srcfile;
-
- if( has_extension(infile,DEF_PROJ_EXTENSION) ) {
- (void)fprintf(stderr,
- "Input from %s disallowed in project mode\n",infile);
- goto next_arg;
- }
-
- if( (input_fd = fopen(infile,"r")) == NULL ) {
- (void)fprintf(stderr,"Cannot open file %s\n",infile);
- goto next_arg;
- }
-
- project_fd = fopen(projfile,"w");
- project_file_input = FALSE;
- }
- else {
- /* Non project file mode: if input file extension
- given, use it. Otherwise read project file
- if it exists else read source file. */
- if( &argv[iarg][argchar]==srcfile
- || (input_fd = fopen(projfile,"r")) == NULL) {
- infile = srcfile;
- if( (input_fd = fopen(infile,"r")) == NULL ) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"Cannot open file %s\n",infile);
- goto next_arg;
- }
- project_file_input =
- has_extension(infile,DEF_PROJ_EXTENSION);
- }
- else {
- infile = projfile;
- project_file_input = TRUE;
- }
- }
-
- /* now that we have a source file, try to open the
- declaration file */
- dcl_fd = (make_dcls > 0 && ! project_file_input) ?
- fopen(dclfile,"w") : (FILE*)NULL;
-
- /* Always print input .f file name. If
- verbose mode, print .prj file names too.
- */
- if(verbose || !project_file_input)
- (void)fprintf(list_fd,"\nFile %s:%s",
- infile,
- full_output?"\n":""
- );
-
- /* In verbose mode, print .prj output
- file name to stderr. Always print
- error message if couldn't open it. */
- if( make_project_file ) {
- if(project_fd != NULL) {
- if(verbose) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,
- "\nProject file is %s\n",projfile);
- }
- }
- else {
- (void)fflush(list_fd);
- (void)fprintf(stderr,
- "\nCannot open %s for output\n",projfile);
- }
- }
-
-
- /* only has effect if done before 1st file*/
- init_typesizes();
-
- if(project_file_input) {
-
- current_filename = projfile;
- proj_file_in(input_fd);
-
- }
- else {
-
- src_file_in(infile);
-
- }
-
- (void) fclose(input_fd);
- }/*end processing file args*/
- }
- next_arg:
- #ifdef OPTION_PREFIX_SLASH
- /* Here we allow /opts to be stuck together */
- while(argv[iarg][++argchar] != '\0'
- && argv[iarg][argchar] != '/') /* look for next opt */
- continue;
-
- } while(argv[iarg][argchar] != '\0'); /*end do-while*/
- #else
- continue;
- #endif
- } /* end for-loop on argument list */
-
-
- /* No files given: read stdin */
- if(actioncount == 0) {
-
- print_version_number();
-
- if( must_open_outfile )
- open_outfile(out_fname);
-
- if(make_project_file) {
- projfile = STDIN_PROJ_FILENAME;
- if( (project_fd = fopen(projfile,"w")) == NULL) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,
- "\nCannot open %s for output\n",projfile);
- }
- else {
- if(verbose) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,
- "\nProject file is %s\n",projfile);
- }
- }
- }
-
- ++filecount;
- input_fd = stdin;
-
- init_typesizes();
-
- src_file_in("std_input");
- }
- if(filecount > 0) {
- wrapup();
- (void)fprintf(list_fd,"\n");
- }
-
- if(show_resources)
- resource_summary();
-
- exit(0);
- return 0;/*NOTREACHED*/
- }
-
- PRIVATE void
- src_file_in(infile)
- char *infile; /* input filename */
- {
- note_filename(infile);
-
- init_scan();
- init_parser();
-
- (void) yyparse();
-
- finish_scan();
-
- if(make_project_file) {
- proj_file_out(project_fd);
- (void) fclose(project_fd);
- }
-
- if ((make_dcls > 0) && (dcl_fd != stdout))
- {
- if (ftell(dcl_fd) == 0L) /* delete an empty .dcl file */
- (void)unlink(dclfile);
- (void) fclose(dcl_fd);
- }
-
- if(port_check && tab_count != 0) {
- nonportable(NO_LINE_NUM,NO_COL_NUM,
- "File contains tabs");
- }
-
- error_summary(infile);
- }
-
- PRIVATE void
- print_version_number()
- {
- if(full_output || verbose)
- (void)fprintf(list_fd,"\n");
- (void)fprintf(list_fd,"%s",VERSION_NUMBER);
- if(help_screen)
- (void)fprintf(list_fd," %s",PATCHLEVEL);
- if(full_output || verbose)
- (void)fprintf(list_fd,"\n");
- }
-
- PRIVATE void
- error_summary(fname) /* Print out count of errors in file */
- char *fname;
- {
- FILE *fd = list_fd;
-
- if(full_output ||
- (verbose && error_count+warning_count != 0))
- (void)fprintf(fd,"\n");
-
- if(full_output || verbose || error_count != 0)
- (void)fprintf(fd,"\n %u syntax error%s detected in file %s",
- error_count, error_count==1? "":"s",
- fname);
-
- if(warning_count != 0)
- (void)fprintf(fd,"\n %u warning%s issued in file %s",
- warning_count, warning_count==1? "":"s",
- fname);
-
- if(full_output ||
- (verbose && error_count+warning_count != 0))
- (void)fprintf(fd,"\n");
-
- error_count = 0;
- warning_count = 0;
- }
-
- void
- print_a_line(fd,line,num) /* Print source line with line number */
- FILE *fd;
- char *line;
- unsigned num;
- {
- (void)fprintf(fd,"\n %6u ",num); /* Print line number */
-
- #ifdef DEC_TABS
- /* Tab-formatted source lines: tab in
- col 1-6 moves to col 7. */
- if(dec_tabs) {
- int i,col;
- for(i=0,col=1; col < 7 && line[i] != '\0'; i++) {
- if(line[i] == '\t') {
- do{
- (void)fprintf(fd," ");
- } while(++col < 7);
- }
- else {
- (void)fprintf(fd,"%c",line[i]);
- ++col;
- }
- }
- (void)fprintf(fd,"%s",line+i);
- }
- else
- #endif
- (void)fprintf(fd,"%s",line);
- }
-
-
- void
- yyerror(s)
- char *s;
- {
- syntax_error(line_num,col_num,s);
- }
-
-
- void
- syntax_error(lineno,colno,s) /* Syntax error message */
- unsigned lineno,colno;
- char *s;
- {
- ++error_count;
- error_message(lineno,colno,s,"Error");
- }
-
- void
- warning(lineno,colno,s) /* Print warning message */
- unsigned lineno,colno;
- char *s;
- {
- ++warning_count;
-
- error_message(lineno,colno,s,"Warning");
- }
-
- void
- ugly_code(lineno,colno,s) /* -pretty message */
- unsigned lineno,colno;
- char *s;
- {
- ++warning_count;
-
- error_message(lineno,colno,s,"Possibly misleading appearance");
- }
-
- void
- nonstandard(lineno,colno)
- unsigned lineno,colno;
- {
- ++warning_count;
- error_message(lineno,colno,"Nonstandard syntax","Warning");
- }
-
- void
- nonportable(lineno,colno,s) /* Print warning about nonportable construction */
- unsigned lineno,colno;
- char *s;
- {
- ++warning_count;
- error_message(lineno,colno,s,"Nonportable usage");
- }
-
- /* error_message prints out error messages and warnings. It
- now comes in two flavors. If using lintstyle_error_message(),
- messages are produced in style like UNIX lint:
-
- "main.f", line nn, col nn: Error: your message here
-
- Otherwise messages by oldstyle_error_message in old ftnchek style:
-
- Error near line nn col nn file main.f: your message here
-
- At this time, oldstyle_error_message is used when -novice is
- in effect, lintstyle_error_message otherwise.
- */
-
- PRIVATE int errmsg_col;
- /* Crude macro to give number of digits in line and column numbers.
- Used by line wrap computation. */
- #define NUM_DIGITS(n) ((n)<10?1:((n)<100?2:((n)<1000?3:(n)<10000?4:5)))
-
- PRIVATE void
- error_message(lineno,colno,s,tag)
- unsigned lineno,colno;
- char *s,*tag;
- {
- if(novice_help)
- oldstyle_error_message(lineno,colno,s,tag);
- else
- lintstyle_error_message(lineno,colno,s,tag);
- }
-
- PRIVATE void
- lintstyle_error_message(lineno,colno,s,tag)
- unsigned lineno,colno;
- char *s,*tag;
- {
- int icol;
- extern unsigned prev_stmt_line_num; /* shared with advance.c */
-
- errmsg_col=1; /* Keep track of line length */
-
- /* Print the character ^ under the column number.
- But if colno == 0, error occurred in prior line.
- If colno is NO_COL_NUM, then print message
- without any column number given.
- */
-
- if(lineno != NO_LINE_NUM) {
- if(colno == NO_COL_NUM) {
- /* colno == NO_COL_NUM means don't give column number.*/
- (void)flush_line_out(lineno);/* print line if not printed yet */
- }
- else if(colno != 0) {
- /* print line if not printed yet */
- if( flush_line_out(lineno) ) {
- /* If it was printed, put ^ under the col */
- (void)fprintf(list_fd,"\n%8s","");
-
- for(icol=1; icol<colno; icol++)
- (void)fprintf(list_fd," ");
- (void)fprintf(list_fd,"^");
- }
- }
- else { /* colno == 0 */
- /* print line if not printed yet */
- (void)flush_line_out(prev_stmt_line_num);
- }
- }
-
- (void)fprintf(list_fd,"\n\"%s\"",current_filename);
- errmsg_col += 2+strlen(current_filename);
-
- if(lineno != NO_LINE_NUM) { /* nonlocal error-- don't flush */
- if(colno == NO_COL_NUM) {
- (void)fprintf(list_fd,
- ", near line %u",lineno);
- errmsg_col += 12+NUM_DIGITS(lineno);
- }
- else if(colno != 0) {
- (void)fprintf(list_fd,
- ", line %u col %u",lineno,colno);
- errmsg_col += 12+NUM_DIGITS(lineno);
- }
- else { /* colno == 0 */
- (void)fprintf(list_fd,
- ", near line %u",prev_stmt_line_num);
- errmsg_col += 12+NUM_DIGITS(lineno);
- }
- }
-
- (void)fprintf(list_fd,": %s:",tag); /* "Warning", "Error", etc. */
- errmsg_col += 3+strlen(tag);
-
- msg_tail(s); /* now append the message string */
- }
-
- /* Our own style messages */
- PRIVATE void
- oldstyle_error_message(lineno,colno,s,tag)
- unsigned lineno,colno;
- char *s,*tag;
- {
- int icol;
- extern unsigned prev_stmt_line_num; /* shared with advance.c */
-
- errmsg_col=1; /* Keep track of line length */
-
- /* Print the character ^ under the column number.
- But if colno == 0, error occurred in prior line.
- If colno is NO_COL_NUM, then print message
- without any column number given.
- */
-
- if(lineno == NO_LINE_NUM) { /* nonlocal error-- don't flush */
- (void)fprintf(list_fd,"\n%s",tag);
- errmsg_col += strlen(tag);
- }
- else {
- if(colno == NO_COL_NUM) {
- /* colno == NO_COL_NUM means don't give column number.*/
- (void)flush_line_out(lineno);/* print line if not printed yet */
- (void)fprintf(list_fd,
- "\n%s near line %u",tag,lineno);
- errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
- }
- else if(colno != 0) {
- /* print line if not printed yet */
- if( flush_line_out(lineno) ) {
- /* If it was printed, put ^ under the col */
- (void)fprintf(list_fd,"\n%8s","");
-
- for(icol=1; icol<colno; icol++)
- (void)fprintf(list_fd," ");
- (void)fprintf(list_fd,"^");
- }
- (void)fprintf(list_fd,
- "\n%s near line %u col %u",tag,lineno,colno);
- errmsg_col += 16+NUM_DIGITS(lineno)+NUM_DIGITS(colno)
- +(unsigned)strlen(tag);
- }
- else { /* colno == 0 */
- /* print line if not printed yet */
- (void)flush_line_out(prev_stmt_line_num);
- (void)fprintf(list_fd,
- "\n%s near line %u",tag,prev_stmt_line_num);
- errmsg_col += 11+NUM_DIGITS(lineno)+(unsigned)strlen(tag);
- }
- }
-
- if(!full_output /* If not listing, append file name */
- || incdepth > 0){ /* Append include-file name if we are in one */
- if(lineno == NO_LINE_NUM) { /* if no line no, preposition needed */
- (void)fprintf(list_fd," in");
- errmsg_col += 3;
- }
- (void)fprintf(list_fd," file %s",current_filename);
- errmsg_col += 6+(unsigned)strlen(current_filename);
- }
-
- (void)fprintf(list_fd,":");
- errmsg_col++;
-
- msg_tail(s); /* now append the message string */
- }
-
- /* msg_tail appends string s to current error message.
- It prints one word at a time, starting a new line
- when the message gets to be too long for one line.
- */
- void
- msg_tail(s)
- char *s;
- {
- int wordstart,wordend,leading_skip,wordchars;
-
- (void)fprintf(list_fd," ");
- errmsg_col++;
- wordstart=0;
- /* Each iteration of loop prints leading space and the
- nonspace characters of a word. Loop invariant: wordstart
- is index of leading space at start of word, wordend is
- index of space char following word. */
- while(s[wordstart] != '\0') {
- leading_skip = TRUE;
- for(wordend=wordstart; s[wordend] != '\0'; wordend++) {
- if(leading_skip) { /* If skipping leading space chars */
- if(!isspace(s[wordend]))
- leading_skip = FALSE; /* go out of skip mode at nonspace */
- }
- else { /* If scanning word chars */
- if(isspace(s[wordend]))
- break; /* quit loop when space char found */
- }
- }
- wordchars = wordend-wordstart;
- /* If word doesn't fit, wrap to next line */
- if( wrap_column > 0 && (errmsg_col += wordchars) > wrap_column) {
- (void)fprintf(list_fd,"\n");
- errmsg_col = wordchars;
- }
- /* Print the word */
- while(wordstart < wordend) {
- (void)putc(s[wordstart++],list_fd);
- }
- }
- }
-
-
- void
- oops_message(severity,lineno,colno,s)
- int severity;
- unsigned lineno,colno;
- char *s;
- {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"\nOops");
- if(lineno != NO_LINE_NUM) {
- (void)fprintf(stderr," at line %u",lineno);
- if(colno != NO_COL_NUM)
- (void)fprintf(stderr," at col %u",colno);
- }
- (void)fprintf(stderr," in file %s",current_filename);
- (void)fprintf(stderr," -- %s",s);
- if(severity == OOPS_FATAL) {
- (void)fprintf(stderr,"\nFtnchek aborted\n");
- (void) exit(1);
- }
- }
-
- void
- oops_tail(s)
- char *s;
- {
- (void)fprintf(stderr," %s",s);
- }
-
- /* get_env_options picks up any options defined in the
- environment. A switch or setting is defined according to
- the value of an environment variable whose name is the switch
- or setting name (uppercased), prefixed by the string
- ENV_PREFIX (e.g. FTNCHEK_). For settings and strsettings,
- the value of the environment variable gives the value to be
- used. For switches, the environment variable is set to "0" or
- "NO" to turn the switch off, or to any other value (including
- null) to turn it on.
- */
-
- PRIVATE void
- get_env_options()
- {
- char env_option_name[32];
- char *value;
- int i;
- for(i=0; i<NUM_SWITCHES; i++) {
- /* Construct the env variable name for switch i */
- make_env_name( env_option_name, switchopt[i].name);
-
- /* See if it is defined */
- if( (value = getenv(env_option_name)) != (char *)NULL) {
- *(switchopt[i].switchflag) =
- !(strcmp(value,"0")==0 || strcmp(value,"NO")==0 );
- }
-
- }
-
- for(i=0; i<NUM_SETTINGS; i++) {
- /* Construct the env variable name for setting i */
- make_env_name( env_option_name, setting[i].name);
- /* See if it is defined */
- if( (value = getenv(env_option_name)) != (char *)NULL) {
- if(read_setting(value, setting[i].setvalue, setting[i].name,
- setting[i].minlimit, setting[i].maxlimit,
- setting[i].turnoff,
- setting[i].min_default_value,
- setting[i].max_default_value) != 0) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"Env setting garbled: %s=%s: ignored\n",
- env_option_name,value);
- }
- }
- }
-
-
- for(i=0; i<NUM_STRSETTINGS; i++) {
- /* Construct the env variable name for setting i */
- make_env_name( env_option_name, strsetting[i].name);
- /* See if it is defined */
- if( (value = getenv(env_option_name)) != (char *)NULL) {
- *(strsetting[i].strvalue) = value;
-
- /* Handle necessary action for -out=listfile */
- if(strsetting[i].strvalue == &out_fname)
- must_open_outfile = TRUE;
- }
- }
- }
-
- /* Routine to concatenate ENV_PREFIX onto option name
- and uppercase the result.
- */
- PRIVATE void
- make_env_name( env_name, option_name)
- char *env_name, *option_name;
- {
- int i,c;
-
- (void)strcat(strcpy(env_name,ENV_PREFIX),option_name);
- for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
- if( islower(c) )
- env_name[i] = toupper(c);
- }
- }
-
-
- /* set_option processes an option from command line. Argument s is
- the option string. First s is compared against boolean switches
- from list in switchopt[]. If s matches switch string,
- corresponding flag is set to TRUE. If no match, then s is compared
- to the same switches prefixed by "no", and if match is found, then
- flag is set to FALSE. Finally, special flags are handled. If still
- no match, an error message is generated.
- */
-
- PRIVATE void
- set_option(s)
- char *s;
- {
- int i;
- /* look for noswitch flags first since otherwise
- an option starting with no might take precedence */
- if(strncmp(s+1,"no",2) == 0) {
- for(i=0; i<NUM_SWITCHES; i++) {
- if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
- *(switchopt[i].switchflag) = FALSE;
- return;
- }
- }
- }
-
- /* -noswitch not found: look for nosetting flag */
- if(strncmp(s+1,"no",2) == 0) {
- for(i=0; i<NUM_SETTINGS; i++) {
- if( strncmp(s+3,setting[i].name,OPT_MATCH_LEN) == 0) {
- *(setting[i].setvalue) = setting[i].turnoff;
- return;
- }
- }
- }
-
- /* Next look for switches */
- for(i=0; i<NUM_SWITCHES; i++) {
- if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
- *(switchopt[i].switchflag) = TRUE;
- return;
- }
- }
-
- /* Handle settings of form "-opt=number" */
- for(i=0; i<NUM_SETTINGS; i++)
- if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
- char *numstr;
-
- numstr = s + OPT_MATCH_LEN;
- while(*++numstr != '\0')
- {
- if((*numstr == '=') || (*numstr == ':'))
- { /* Find the assignment operator */
- numstr++;
- break;
- }
- }
- if(read_setting(numstr, setting[i].setvalue, setting[i].name,
- setting[i].minlimit, setting[i].maxlimit,
- setting[i].turnoff,
- setting[i].min_default_value,
- setting[i].max_default_value) != 0) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"Setting garbled: %s: ignored\n",s);
- }
- return;
- }
-
-
- /* Handle settings of form "-opt=string" */
- for(i=0; i<NUM_STRSETTINGS; i++)
- if( strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
- char *strstart;
- #ifdef OPTION_PREFIX_SLASH
- int numchars;
- #endif
- strstart = s + (OPT_MATCH_LEN + 1);
- while(*strstart != '=' && *strstart != '\0')
- strstart++; /* Find the = sign */
- if(*strstart == '\0') {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"String setting missing: %s: ignored\n",s);
- return;
- }
- else {
- *(strsetting[i].strvalue) = ++strstart;
- /* In VMS,MSDOS worlds, user might not leave
- blank space between options. If string
- is followed by '/', must make a properly
- terminated copy. */
- #ifdef OPTION_PREFIX_SLASH
- for(numchars=0; strstart[numchars] != '\0'
- && strstart[numchars] != '/'; numchars++)
- continue;
- if(strstart[numchars] != '\0') {
- strncpy( *(strsetting[i].strvalue)=malloc(numchars+1),
- strstart,numchars);
- }
- #endif
-
- }
- /* Handle necessary action for -out=listfile */
- if(strsetting[i].strvalue == &out_fname) {
- must_open_outfile = TRUE;
- }
- return;
- }
-
-
- /* No match found: issue error message */
-
- (void)fflush(list_fd);
- (void)fprintf(stderr,"\nUnknown commandline switch: %s\n",s);
- }
-
-
- /* Routine to read integer setting from string s and check if valid */
-
- PRIVATE int
- read_setting(s, setvalue, name, minlimit, maxlimit, turnoff, min_default_value,
- max_default_value)
- char *s;
- int *setvalue;
- char *name;
- int minlimit, maxlimit, turnoff, min_default_value, max_default_value;
- {
- int given_val;
-
- if(strcmp(s,"NO")==0) {
- *(setvalue) = turnoff;
- }
- else if(*s == '\0' || sscanf(s,"%d", &given_val) == 0) {
- return -1; /* error return: garbled setting */
- }
- else { /* If outside limits, set to default */
- int Ok=TRUE;
- if(given_val < minlimit) {
- given_val = min_default_value;
- Ok = FALSE;
- }
- else if(given_val > maxlimit) {
- given_val = max_default_value;
- Ok = FALSE;
- }
-
- if(! Ok ) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"\nSetting: %s",name);
- (void)fprintf(stderr," outside limits %d to %d",
- minlimit,maxlimit);
- (void)fprintf(stderr,": set to default %d\n",given_val);
- }
-
- *(setvalue) = given_val;
- }
- return 0;
- }
-
- PRIVATE void
- open_outfile(s) /* open the output file for listing */
- char *s;
- {
- char *fullname; /* given name plus extension */
- FILE *fd;
-
- must_open_outfile = FALSE; /* Turn off the flag */
-
- if(s == (char *) NULL || *s == '\0') {
- return; /* No filename: no action */
- }
-
- fullname = add_ext(s,DEF_LIST_EXTENSION);
- (void)fflush(list_fd);
- if( (fd = fopen(fullname,"w")) == NULL) {
- (void)fprintf(stderr,"\nCannot open %s for output\n",fullname);
- }
- else {
- (void)fprintf(stderr,"\nOutput sent to file %s\n",fullname);
- list_fd = fd;
- }
- }
-
-
- PRIVATE void
- list_options(fd)/* List all commandline options, strsettings, and settings */
- FILE *fd;
- {
- int i;
-
- /* Print the copyright notice */
- (void)fprintf(fd,"\n%s",COPYRIGHT_DATE);
- (void)fprintf(fd,"\n%s\n",COPYRIGHT_NOTICE);
-
- /* Note: Headings say "default" but to be accurate they
- should say "current value". This would be confusing. */
- (void)fprintf(fd,"\nCommandline options [default]:");
- for(i=0; i<NUM_SWITCHES; i++) {
-
- if( !debug_latest &&
- strncmp(switchopt[i].explanation,"debug",5) == 0)
- continue; /* skip debug switches unless debug mode */
-
- (void)fprintf(fd,"\n %c[no]%s",OPT_PREFIX,switchopt[i].name);
- (void)fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
- (void)fprintf(fd,": %s",switchopt[i].explanation);
- }
- /* String settings follow switches w/o their own heading */
- for(i=0; i<NUM_STRSETTINGS; i++) {
- if( !debug_latest &&
- strncmp(strsetting[i].explanation,"debug",5) == 0)
- continue; /* skip debug settings unless debug mode */
-
- (void)fprintf(fd,"\n %c%s=str ",OPT_PREFIX,strsetting[i].name);
- (void)fprintf(fd,"[%s]",
- *(strsetting[i].strvalue)? *(strsetting[i].strvalue): "NONE");
- (void)fprintf(fd,": %s",strsetting[i].explanation);
- }
-
- (void)fprintf(fd,"\nSettings (legal range) [default]:");
- for(i=0; i<NUM_SETTINGS; i++) {
-
- if( !debug_latest &&
- strncmp(setting[i].explanation,"debug",5) == 0)
- continue; /* skip debug settings unless debug mode */
-
- (void)fprintf(fd,"\n %c%s=dd ",OPT_PREFIX,setting[i].name);
- (void)fprintf(fd,"(%d to %d) ",setting[i].minlimit,
- setting[i].maxlimit);
- (void)fprintf(fd,"[%d]",*(setting[i].setvalue));
- (void)fprintf(fd,": %s",setting[i].explanation);
- }
-
- (void)fprintf(fd,
- "\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
- }
-
-
- PRIVATE void
- wrapup() /* look at cross references, etc. */
- {
- if(debug_hashtab || debug_glob_symtab)
- debug_symtabs();
-
- visit_children(); /* Make call tree & check visited status */
- check_com_usage(); /* Look for unused common stuff */
- check_comlists(); /* Look for common block mismatches */
- check_arglists(); /* Look for subprog defn/call mismatches */
-
- #ifdef DEBUG_GLOBAL_STRINGS
- if(debug_latest)
- print_global_strings();
- #endif
- }
-
-
- #define MODE_DEFAULT_EXT 1
- #define MODE_REPLACE_EXT 2
- PRIVATE char *
- append_extension(s,ext,mode)
- char *s,*ext;
- int mode;
- {
- /* MODE_DEFAULT_EXT: Adds extension to file name s if
- none is present, and returns a pointer to the
- new name. If extension was added, space is allocated
- for the new name. If not, simply returns pointer
- to original name. MODE_REPLACE_EXT: same, except given
- extension replaces given one if any.
- */
- int i,len;
- char *newname;
- #ifdef OPTION_PREFIX_SLASH /* set len=chars to NUL or start of /opt */
- for(len=0; s[len] != '\0' && s[len] != '/'; len++)
- continue;
- #else
- len=(unsigned)strlen(s);
- #endif
- /* Search backwards till find the dot, but do not
- search past directory delimiter
- */
- for(i=len-1; i>0; i--) {
- if(s[i] == '.'
- #ifdef UNIX
- || s[i] == '/'
- #endif
- #ifdef VMS
- || s[i] == ']' || s[i] == ':'
- #endif
- #ifdef MSDOS
- || s[i] == '\\' || s[i] == ':'
- #endif
- )
- break;
- }
-
- if(mode == MODE_REPLACE_EXT) {
- if(s[i] == '.') /* declare length = up to the dot */
- len = i;
- newname = (char *) malloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
- (void)strncpy(newname,s,len);
- (void)strcpy(newname+len,ext);
- }
- else { /* MODE_DEFAULT_EXT */
- #ifdef OPTION_PREFIX_SLASH
- /* create new string if new ext or trailing /option */
- if(s[i] != '.' || s[len] != '\0') {
- if(s[i] != '.') { /* no extension given */
- newname = (char *) malloc( (unsigned)(len+
- (unsigned)strlen(ext)+1) );
- (void)strncpy(newname,s,len);
- (void)strcpy(newname+len,ext);
- }
- else { /* extension given but /option follows */
- newname = (char *) malloc( (unsigned)(len+1) );
- (void)strncpy(newname,s,len);
- }
- }
- #else
- if(s[i] != '.') {
- newname = (char *) malloc( (unsigned)(len+
- (unsigned)strlen(ext)+1) );
- (void)strcpy(newname,s);
- (void)strcat(newname,ext);
- }
- #endif
- else {
- newname = s; /* use as is */
- }
- }
-
- return newname;
- }
-
- /* Adds default extension to source file name, replacing
- any that is present, and returns a pointer to the
- new name. Space is allocated for the new name.
- */
- #ifndef VMS_INCLUDE
- PRIVATE
- #endif
- char *
- add_ext(s,ext) /* adds default filename extension to s */
- char *s,*ext;
- {
- return append_extension(s,ext,MODE_DEFAULT_EXT);
- }
-
- PRIVATE char *
- new_ext(s,ext)
- char *s,*ext;
- {
- return append_extension(s,ext,MODE_REPLACE_EXT);
- }
-
-
- PRIVATE int
- cistrncmp(s1,s2,n) /* case-insensitive strncmp */
- char *s1,*s2;
- unsigned n;
- {
- while( n != 0 &&
- (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
- if(*s1 == '\0')
- return 0;
- if(*s2 == '\0')
- break;
- ++s1; ++s2; --n;
- }
- return n==0? 0: *s1 - *s2;
- }
-
- #ifndef VMS_INCLUDE
- PRIVATE
- #endif
- int
- has_extension(name,ext) /* true if name ends in ext */
- char *name,*ext;
- {
- unsigned name_len, ext_len;
- int stem_len;
- ext_len = strlen(ext);
-
- #ifdef VMS /* shell_glob adds version number: filename.ext;1 */
- if(strrchr(name,';') != NULL) {
- name_len = strrchr(name,';') - name; /* distance to the semicolon */
- }
- else
- #endif
- name_len=strlen(name); /* distance to the null */
-
- stem_len = (unsigned)(name_len - ext_len); /* distance to the dot */
-
- if( stem_len >= 0 &&
- (name_len-stem_len) == ext_len &&
- cistrncmp(name+stem_len,ext,ext_len) == 0 )
- return TRUE;
- else
- return FALSE;
- }
-
- /* Add an include directory path to list of paths */
- #ifdef ALLOW_INCLUDE
- PRIVATE void
- append_include_path(new_path)
- char *new_path;
- {
- IncludePathNode *new_path_node, *p;
- if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
- ==(IncludePathNode *)NULL) {
- (void)fflush(list_fd);
- (void)fprintf(stderr,"\nmalloc error getting path list");
- }
- else {
- new_path_node->link = (IncludePathNode *)NULL;
- new_path_node->include_path = new_path;
- /* Append the new node at end of list */
- if((p=include_path_list) == (IncludePathNode *)NULL)
- include_path_list = new_path_node;
- else {
- while(p->link != (IncludePathNode *)NULL)
- p = p->link;
- p->link = new_path_node;
- }
- }
- }
- #endif/*ALLOW_INCLUDE*/
-
- PRIVATE void
- resource_summary()
- {
- #ifdef DEBUG_SIZES
- if(debug_latest)
- print_sizeofs(); /* give sizeof various things */
- #endif
-
- (void)fprintf(list_fd,
- "\n Here are the amounts of ftnchek's resources that were used:\n");
-
- (void)fprintf(list_fd,
- "\nSource lines processed = %lu statement + %lu comment = %lu total",
- tot_stmt_line_count,
- tot_line_count-tot_stmt_line_count, /*tot_comment_line_count*/
- tot_line_count);
-
- (void)fprintf(list_fd,
- "\nTotal executable statements = %lu, max in any module = %lu",
- tot_exec_stmt_count,
- max_exec_stmt_count);
-
- (void)fprintf(list_fd,
- "\nTotal number of modules in program = %lu",
- tot_module_count);
-
- (void)fprintf(list_fd,
- "\nMax identifier name chars used = %lu local, %lu global, chunk size %lu",
- max_loc_strings,
- glob_strings_used,
- (unsigned long)STRSPACESZ);
- (void)fprintf(list_fd,
- "\nMax token text chars used = %lu, chunk size %lu ",
- max_srctextspace,
- (unsigned long)STRSPACESZ);
- (void)fprintf(list_fd,
- "\nMax local symbols used = %lu out of %lu available",
- max_loc_symtab,
- (unsigned long)LOCSYMTABSZ);
- (void)fprintf(list_fd,
- "\nMax global symbols used = %lu out of %lu available",
- max_glob_symtab,
- (unsigned long)GLOBSYMTABSZ);
- (void)fprintf(list_fd,
- "\nMax number of parameter info fields used = %lu, chunk size = %lu",
- max_paraminfo,
- (unsigned long)PARAMINFOSPACESZ);
- (void)fprintf(list_fd,
- "\nMax number of tokenlists used = %lu, chunk size = %lu",
- max_tokenlists,
- (unsigned long)TOKHEADSPACESZ);
- (void)fprintf(list_fd,
- "\nMax token list/tree space used = %lu, chunk size = %lu",
- max_token_space,
- (unsigned long)TOKENSPACESZ);
- (void)fprintf(list_fd,
- "\nNumber of subprogram invocations = %lu totaling %lu args",
- arglist_head_used,
- arglist_element_used);
- (void)fprintf(list_fd,
- "\nArgument list header and element chunk sizes = %lu and %lu",
- (unsigned long)ARGLISTHEADSZ,
- (unsigned long)ARGLISTELTSZ);
- (void)fprintf(list_fd,
- "\nNumber of common block decls = %lu totaling %lu variables",
- comlist_head_used,
- comlist_element_used);
- (void)fprintf(list_fd,
- "\nCommon list header and element chunk sizes = %lu and %lu",
- (unsigned long)COMLISTHEADSZ,
- (unsigned long)COMLISTELTSZ);
- (void)fprintf(list_fd,
- "\nNumber of array dim ptrs used = %lu, chunk size = %lu",
- max_ptrspace,
- (unsigned long)PTRSPACESZ);
-
- #ifdef DEBUG_SIZES
- (void)fprintf(list_fd,
- "\nIdentifier hashtable size = %6lu",
- (unsigned long)HASHSZ);
- #ifdef KEY_HASH/* not used any more*/
- (void)fprintf(list_fd,
- "\nKeyword hashtable size = %6lu",
- (unsigned long)KEYHASHSZ);
- #endif
- #ifdef COUNT_REHASHES
- (void)fprintf(list_fd,
- "\nIdentifier rehash count = %6lu",
- rehash_count);
- #endif
- (void)fprintf(list_fd,
- "\nIntrinsic function hashtable size=%6lu, clash count=%lu",
- (unsigned long)INTRINS_HASHSZ,
- intrins_clashes);
- #endif /*DEBUG_SIZES*/
-
- (void)fprintf(list_fd,"\n\n");
- }
-